room 750000 u<
[IF]
	cr .( not enough dic room to compile callsMod!) cr  ABORT
[THEN]

false	constant	debug?

file  INPF

: #ALIGN4	\ ( n -- n' )
	3 + $ fffffffc and  ;


true -> case_in_names?

: macConstant
	[ FALSE -> CASE_IN_NAMES? ]
	>in @
	defined?
	IF		['] inpf u>  IF  2drop  EXIT  THEN
	ELSE	drop
	THEN
	>in !
	constant
;


: [IF]		drop  ;
: [ELSE]	;
: [THEN]	;
: [ELIF]	drop  ;


true -> case_in_names?

: macDefined?	DEFINED? NIP  ;
: macStruct		MWORD DROP  ;
: macUnion		MWORD DROP	;
: macField		DROP  MWORD DROP  ;
: macFiller		2DROP  ;
: macEnd-struct	2DROP  ;
: macEnd-union	2DROP  ;
: macSynonym	MWORD DROP  MWORD DROP  ;

: and			AND  ;
: or			OR   ;
: xor			XOR  ;
: lshift		LSHIFT  ;
: rshift		RSHIFT  ;
: negate		NEGATE  ;
: 'type			POSTPONE 'TYPE  ;  IMMEDIATE


FALSE -> CASE_IN_NAMES?


string temp

: READ_INLINE  { \ loc svd svCaseFlg -- }
	case_in_names? -> svCaseFlg
	false -> case_in_names?
	clear: temp
	BEGIN
		>in @  src-len  >=
		IF	svCaseFlg -> case_in_names?  EXIT
		THEN
		hex  mword number  decimal
		pad w!  pad 2 add: temp
	AGAIN  ;


false	value	register_based?
0		value	^hndlr

(*	For 68k parms, a parm or result might be in a register.  If so,
	our parm info will have this format:

	byte 0		0
	byte 1		$80 + reg number
	byte 2		0
	byte 3		length in bytes
	
	The reg numbers, as defined in MixedMode.h, are:
	0	d0
	1	d1
	2	d2
	3	d3
	4	a0
	5	a1
	6	a2
	7	a3
	8	d4
	9	d5
	A	d6
	B	d7
	C	a4
	D	a5
	E	a6
	
	We have to return a 1-byte result, so we use this format:
	
	bit
	0		1			means this is a register parm/result
	1-3		length
	4-7		reg code
	
	This byte is passed to Handlers which compiles the right register
	pushes and/or pops.
*)

: 68k_parm_adjust  { parm parm# parm? -- parm' }
	parm -1 =
	NIF
		parm $ ffff0000 and
		IF						\ it's a register parm
			true -> register_based?
			$ D001  ^hndlr w!
			parm dup 16 >>		\ reg code
			swap 3 and			\ length
			4 << or  EXIT
		THEN
	THEN
	
	parm?						\ parm or result?
	IF							\ parm
		register_based?
		IF ." warning - non-reg parm in reg-based call  "
			latest name> .id  cr
		THEN
		parm
\		dup 1 and +			\ &&& don't round length any more
	ELSE						\ result
		parm IF
			register_based?
			IF ." warning - non-reg result in reg-based call  "
				latest name> .id  cr
			THEN
		THEN
		parm						\ for results, we don't round so call
	THEN							\  windup gets done properly.
;


	true -> case_in_names?

: macExtern

	[ FALSE -> CASE_IN_NAMES? ]

( result-info parm-info #parms )
		{ \ #parms #cells #fparms #fres mask ^PPCinfo ^68kInfo -- }

	0 -> #cells  0 -> #fparms  false -> register_based?
	0 -> #fres  0 -> mask

\	true -> case_in_names?
	>in @
	defined?
	IF	['] inpf u>
		IF  drop					\ drop >in - now TOS is # parms
			-1 DO  2drop  LOOP		\ drop parm info, also result info
			0 -> src-len			\ skip 68k inline code sequence
\			false -> case_in_names?
			EXIT
		THEN
	ELSE	drop
	THEN

	>in !
	create						\ create the new dic entry (case sensitive)
\	false -> case_in_names?
	DP 2-  -> ^hndlr
	$ D000  ^hndlr w!			\ dummy "handler code"
	DP -> ^PPCinfo  0 ,  0 w,	\ leave space for PPC info
	
\ #parms
	dup -> #parms  c,			\ store # parms for 68k
	DP -> ^68kInfo
	#parms
	IF	pad #parms n,			\ reserve space for rest of 68k parm info

		#parms
		FOR
		\ #bytes in next PPC parm - convert to #cells and accumulate.  If
		\  the $ 1000 bit is set, that means it's floating point - in that
		\  case we count up the number of floating parms (these have to
		\  be put in the FPRs for the call), and set the corresponding mask
		\  bit so that the corresponding GPRs will get a dummy value.  This
		\  calling convention is a bit crazy, but we're stuck with it.
		\ Remember as the numbers have been pushed onto the stack, we're
		\  going from the last parm backwards.  So i in this FOR loop gives
		\  us the real parm# starting from zero.
		
			dup $ 1000 and
			IF				\ it's floating
				1 ++> #fparms
				$ FFF and  dup 4 >
				IF		mask 2 >>  $ C000 or  -> mask	\ mask 2 dummy GPRs here
				ELSE	mask 1 >>  $ 8000 or  -> mask	\ single float - mask 1 GPR
				THEN
			ELSE
				mask 1 >>  -> mask					\ normal GPR cell - no mask bit
			THEN
			3 +  2 >>  ++> #cells

		\ 68k parm info
			i true 68k_parm_adjust		\ check if reg-based and take care of it
			^68kInfo i + c!				\ store in right order in 68k info
		NEXT
	THEN

	#cells		^PPCinfo c!			\ store # PPC parm cells at ^PPCinfo

\ ( #68k-res-bytes #PPC-res-bytes )

	dup $ 1000 and
	IF								\ PPC result is floating - so no integer result
		1 -> #fres  drop 0
	ELSE							\ otherwise there's no floating result
		3 +  2 >>
	THEN		^PPCinfo 1+ c!		\ store # PPC integer result cells at ^PPCinfo+1
	#fparms		^PPCinfo 2+ c!		\  and # PPC FP parms at ^PPCinfo+2
	#fres		^PPCinfo 3 + c!		\  and # PPC FP results at ^PPCinfo+3
									\  (must be 0 or 1)
	mask		^PPCinfo 4+  w!

	0 false 68k_parm_adjust  c,		\ store 68k info.  We don't
									\  round here since we have to know whether
									\  and by how much to adjust by at the end
									\  of the call.
	align-dp
	read_inline
	reset: temp  len: temp  w,  all: temp  n,

	0 -> src-len		\ on the PPC we ignore the 68k inline code sequence
;


: FIND_IN_CALLSMOD	\ ( s255 \ svCaseFlg -- cfa true | -- s255 false )
	find: callsMod
;


: myHeader
	PPC? IF  ppc_header  ELSE  header  THEN  ;


: KONST  { \ svCaseFlg -- konst }
	case_in_names? -> svCaseFlg
	true -> case_in_names?
	['] find_in_callsMod  -> extraFind
	'
	svCaseFlg -> case_in_names?
	0 -> extraFind
	dup 2- w@x  -4 <>  abort" not a konst!"
	@  postpone lit
;		immediate


: $>KONST  { addr len \ svCaseFlg -- konst }
	case_in_names? -> svCaseFlg
	true -> case_in_names?
	['] find_in_callsMod  -> extraFind
	addr len sFind
	svCaseFlg -> case_in_names?
	0 -> extraFind
	NIF  abort" konst not defined"  THEN
	dup 2- w@x  -4 <>  abort" not a konst!"
	@
;


(*
syscall bloggs  defines "bloggs" as an system call (from the InterfaceLib
library).

In a definition we just put "bloggs" and it compiles a call to bloggs.  We
resolve the symbol via a FindSymbol call, the first time it's called (see
get_transfer_vector in Setup - a call is compiled to there as part of the
external call sequence, compiled by call_extern in cg5).
*)

: SYSCALL  { \	svCaseFlg sv-in addr #parms
				#parm_cells #fparms #res_cells #fres mask
				len ^len-byte  name_len -- }
	?exec
	>in @  -> sv-in

\ first, is it actually a known call?

	case_in_names? -> svCaseFlg
	true -> case_in_names?
	['] find_in_callsMod  -> extraFind
	mword find NIF  150 die  THEN		\ "can't find call for this name"
	0 -> extraFind  svCaseFlg -> case_in_names?
	-> addr
	addr 2- w@
	dup 1 and  -> register_based?
	-2 and  $ D000 <>  abort" not a call!"

\ now, if we've already defined it as a sysCall, and it's currently
\  FINDable, we don't need to define it again here.

	sv-in  >in !
	defined?
	IF	2- w@x
		CASE[ -120 ], [ -122 ]=>	PPC? 0EXIT
			[ $ BF01 ]=>			PPC? ?EXIT
			DEFAULT=>  drop
		]CASE
	ELSE
		drop
	THEN

	sv-in  >in !

	PPC?
	IF	myHeader  $ BF01  codeW,		\  $BF01 = handler code for sysCall

		addr c@		-> #parm_cells
		addr 1+ c@	-> #res_cells
		addr 2+ c@	-> #fparms
		addr 3 + c@	-> #fres
		addr 4+  w@ -> mask

		#parm_cells codeC,		\ 1 byte # parm cells
		#res_cells codeC,		\ 1 byte # result cells
		#fparms  codeC,			\ 1 byte # FP parms (in FPRs)
		#fres  codeC,			\ 1 byte # FP results (in FPRs)
		mask  codeW,

		DP  nilP ,				\ put nilP in data area - means not resolved yet
		" relocCode,x" evaluate			\ not defined till cg6
		0 code,							\ for EXTERNs, lib addr goes here.  For SYSCALL,
										\  we put zero.  (This is different to 68k)
		addr >name n>count dup -> name_len
		CDP place
		name_len 2+ #align4  ++> CDP
	ELSE
		header
		register_based?  IF  -122  ELSE  -120  THEN
		w,						\ sysCall_h handler for 68k
		6 ++> addr				\ look at 68k parm info
		addr c@  -> #parms
		DP -> ^len-byte  0 c,	\ total length of call info will go here
		#parms c,
		1 ++> addr
		#parms 1+ FOR			\ add 1 since we're including the result byte
			addr c@  c,  1 ++> addr
		NEXT
		addr 1 and  ++> addr
		1 or> DP				\ put DP to odd bdry since we'll be omitting
								\  the length byte
		addr length				\ ( addr len ) for inline code
		dup NIF  152 die  THEN	\ "not a real call" - since no inline code
		n,						\ move inline code over
		DP ^len-byte - 1-
		^len-byte c!			\ and store length of call info (excluding length byte)
	THEN
;


new: temp

cr
cr .( Note: loading this next file will take quite a while.)
cr .( A coffee break would be a good idea.)  cr

true -> case_in_names?
// xcalls
FALSE -> CASE_IN_NAMES?

release: temp

cr .( Dic room at end of compiling callsMod: )  room . cr